home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / oper_sys / oasis / oasisegs.lha / egs / queena.lisp < prev    next >
Lisp/Scheme  |  1992-04-23  |  1KB  |  43 lines
  1. (proclaim '(type fixnum           *count*))
  2. (proclaim '(type (array fixnum 2) *all*))
  3. (proclaim '(type (array fixnum 1) *board*)
  4.  
  5. (proclaim '(function run   (fixnum) nil))
  6. (proclaim '(function queen (fixnum fixnum) nil))
  7. (proclaim '(function safe  (fixnum fixnum) boolean))
  8.  
  9. (defvar *count* 0)
  10. (defvar *all*   (make-array '(800 10)
  11.                 :element-type 'fixnum
  12.                 :initial-element 0))
  13. (defvar *board* (make-array '(10)
  14.                 :element-type 'fixnum)
  15.  
  16. (defun run (size)
  17.        (declare (type fixnum size))
  18.        (queen 0 size) )
  19.  
  20. (defun queen (n size)
  21.        (declare (type fixnum n)
  22.                 (type fixnum size) )
  23.        (cond ((= n size) 
  24.               (do ((i 0 (+ i 1)))
  25.                   ((= i n) (incf *count*))
  26.                   (declare (type fixnum i))
  27.                   (setf (aref *all* *count* i) (aref *board* i)) ))
  28.              (t (do ((m 0 (+ m 1)))
  29.                     ((= m size))
  30.                     (declare (type fixnum m))
  31.                     (when (safe m 1)
  32.                           (setf (aref *board* n) m)
  33.                           (queen (+ n 1) size) )))))
  34.  
  35. (defun safe (m n)
  36.        (declare (type fixnum m)
  37.                 (type fixnum n) )
  38.        (do ((i 1 (+ i 1)))
  39.            ((> i n) t)
  40.            (let ((x (aref *board* (- n i))))
  41.                 (declare (type fixnum x))
  42.                 (if (or (= m x) (= m (+ x i)) (= m (- x i))) return nil) )))
  43.